home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / EDUCUAGE / GREEK.LZH / SORTG.BAS < prev    next >
BASIC Source File  |  1987-05-04  |  9KB  |  276 lines
  1. 100 REM  ***********************************************************
  2. 150 REM  *                      RHEMA 1.0                           *
  3. 200 REM  *            GREEK VOCABULARY DRILL SYSTEM                 *
  4. 220 REM  *                     SORT SUB-PROGRAM                     *
  5. 250 REM  *                                                          *
  6. 300 REM  *  COPYRIGHT 1987 BY DANIEL R. CRIDER                      *
  7. 350 REM  *       THIS PROGRAM IS RELEASED INTO THE PUBLIC DOMAIN    *
  8. 400 REM  *  ON A SHAREWARE BASIS. PLEASE SEND $15 TO DANIEL CRIDER  *
  9. 450 REM  *  FOR THE RIGHT TO USE THIS PROGRAM. THIS PROGRAM IS NOT  *
  10. 500 REM  *  TO BE RE-SOLD OR RE-RELEASED WITH ANY COMMERCIAL        *
  11. 550 REM  *  PACKAGE OR PROGRAM.                                     *
  12. 600 REM  *  FOR NOTICE OF OTHER RIGHTS AND RESTRICTIONS PLEASE      *
  13. 650 REM  *  SEE THE FILE RHEMA.DOC WHICH SHOULD BE SUPPLIED WITH    *
  14. 700 REM  *  THIS PROGRAM. PLEASE MAIL YOUR PAYMENT AND ANY COMMENTS *
  15. 750 REM  *  TO:                                                     *
  16. 900 REM  *        DANIEL CRIDER                                     *
  17. 950 REM  *        6604 CERVANTES AVE                                *
  18. 1000 REM *        FT. WORTH, TEXAS 76133                            * 
  19. 1050 REM *                                                          *
  20. 1070 REM ************************************************************
  21. 1100 REM ************  SET UP ARRAYS
  22. 1150 DIM LI(30),US(30)
  23. 1160 DIM GC(6)
  24. 1170 FOR I=1 TO 6:GC(I)=0:NEXT I
  25. 1200 ML=0
  26. 1250 DIM W1$(12),W2$(12),WD(2,12)
  27. 1300 DIM LETT$(30,9),LN$(30),CN$(15)
  28. 1350 DIM ACC$(15,3)
  29. 1400 DIM EG$(30),GZ$(6)
  30. 1450 GOSUB 4700
  31. 1500 REM ************  LOAD ALPHABET
  32. 1550 PRINT
  33. 1600 PRINT TAB(36);"RHEMA 1.0"
  34. 1650 PRINT
  35. 1700 PRINT TAB(18);"     COPYRIGHT 1987 BY DANIEL R. CRIDER"
  36. 1750 PRINT
  37. 1800 OPEN "I",1,"ALPHA.BAS"
  38. 1850 FOR I=1 TO 30
  39. 1950 PRINT "PLEASE STANDBY.....LOADING GREEK LETTERS ";I
  40. 2000 GOSUB 4850
  41. 2050 FOR J=1 TO 9
  42. 2100 LINE INPUT#1,AX$
  43. 2150 LETT$(I,J)=MID$(AX$,13,6)
  44. 2200 NEXT J
  45. 2250 NEXT I
  46. 2300 PRINT
  47. 2350 FOR I=1 TO 15
  48. 2450 PRINT "...................LOADING GREEK ACCENTS ";I
  49. 2500 GOSUB 4850
  50. 2550 FOR J=1 TO 3
  51. 2600 LINE INPUT#1,AX$
  52. 2650 ACC$(I,J)=MID$(AX$,13,6)
  53. 2700 NEXT J
  54. 2750 NEXT I
  55. 2800 PRINT
  56. 2850 CLOSE #1
  57. 2900 FOR I=1 TO 30:READ LN$(I):NEXT I
  58. 2950 FOR I=1 TO 15:READ CN$(I):NEXT I
  59. 3000 FOR I=1 TO 30:READ EG$(I):NEXT I
  60. 3020 FOR I=1 TO 6:READ GZ$(I):NEXT I
  61. 3050 PRINT
  62. 3100 PRINT
  63. 3150 PRINT "ENTER SOME NUMBER FOR THE RANDOM SEED"
  64. 3200 PRINT "THE SAME NUMBER USED EACH TIME WILL GIVE THE SAME DRILLS"
  65. 3250 RANDOMIZE
  66. 3300 REM ************  OPEN VOCABULARY FILE
  67. 3350 PRINT
  68. 3400 PRINT "PLEASE ENTER THE NAME OF YOUR VOCABULARY FILE"
  69. 3450 PRINT "STRIKE THE CARRIAGE RETURN KEY ONLY IF YOU WISH TO"
  70. 3500 PRINT "USE THE DEFAULT NAME OF VOCAB"
  71. 3550 PRINT "VOCABULARY FILE NAME.....";
  72. 3600 INPUT AX$
  73. 3650 IF AX$="" THEN AX$="VOCAB"
  74. 3700 GOSUB 4850
  75. 3750 PRINT "VOCABULARY FILE NAME.....";AX$
  76. 3800 AX$=AX$ + ".GRK"
  77. 3850 PRINT "PLEASE STANDBY...SCANNING VOCABULARY FILE"
  78. 3900 OPEN "R",#1,AX$,125
  79. 3950 FIELD #1,2 AS W1$(1),2 AS W1$(2),2 AS W1$(3),2 AS W1$(4),2 AS W1$(5),2 AS W1$(6),2 AS W1$(7),2 AS W1$(8),2 AS W1$(9),2 AS W1$(10),2 AS W1$(11),2 AS W1$(12),101 AS Y5$
  80. 4000 FIELD #1,24 AS Y4$,2 AS W2$(1),2 AS W2$(2),2 AS W2$(3),2 AS W2$(4),2 AS W2$(5),2 AS W2$(6),2 AS W2$(7),2 AS W2$(8),2 AS W2$(9),2 AS W2$(10),2 AS W2$(11),2 AS W2$(12),2 AS KG$, 65 AS DF$
  81. 4050 LR=1
  82. 4100 DL=0
  83. 4150 GET #1,LR
  84. 4160 GZ=CVI(KG$)
  85. 4170 GC(GZ)=GC(GZ)+1
  86. 4200 IF EOF(1) GOTO 4450
  87. 4250 WD(2,1)=CVI(W2$(1))
  88. 4300 IF WD(2,1)=99 THEN DL=DL+1
  89. 4350 LR=LR+1
  90. 4400 GOTO 4150
  91. 4450 LR=LR-1
  92. 4500 GOTO 5150
  93. 4550 REM ************ RING BELL CODE
  94. 4600 PRINT CHR$(7);CHR$(7);
  95. 4650 RETURN
  96. 4700 REM ************  CLEAR SCREEN CODE
  97. 4750 PRINT CHR$(26)
  98. 4800 RETURN
  99. 4850 REM ************  CURSOR UP SCREEN CODE
  100. 4900 PRINT CHR$(11);
  101. 4950 RETURN
  102. 5000 REM ************ CURSOR DOWN SCREEN CODE
  103. 5050 PRINT CHR$(10);
  104. 5100 RETURN
  105. 5150 REM ************  DISPLAY MENU
  106. 5200 REM ************* RESET SOME VARIABLES BEFORE MENU DISPLAY
  107. 5210 LM$="N"
  108. 5250 SX$=""
  109. 5300 TX=0
  110. 5350 SU=0
  111. 5400 GOSUB 4700
  112. 5450 PRINT TAB(22);"CURRENTLY ";LR-DL;" VOCABULARY WORDS ON FILE"
  113. 5500 PRINT
  114. 5550 PRINT
  115. 5600 PRINT TAB(35);"RHEMA 1.0"
  116. 5650 PRINT TAB(25);"GREEK VOCABULARY DRILL SYSTEM"
  117. 5700 PRINT TAB(35);"SORT SUB-PROGRAM"
  118. 5750 PRINT
  119. 6050 PRINT TAB(25);"1-- PRINT VOCABULARY"
  120. 6150 PRINT TAB(25);"2-- END PROGRAM"
  121. 6200 PRINT
  122. 6250 PRINT
  123. 6300 PRINT TAB(28);"PLEASE ENTER YOUR CHOICE ";
  124. 6350 INPUT M
  125. 6400 IF M>2 OR M<1 THEN 6300
  126. 6450 ON M GOTO 31800,6500
  127. 6500 REM ************  END PROGRAM
  128. 6550 PRINT "READY TO QUIT? (Y OR N) ";
  129. 6600 INPUT X$
  130. 6650 IF X$<>"Y" AND X$<>"N" THEN 6550
  131. 6700 IF X$="N" THEN 5150
  132. 6750 CLOSE #1
  133. 6800 SYSTEM
  134. 24100 REM ************  READ A WORD
  135. 24150 GET #1, TR
  136. 24200 EL$=""
  137. 24250 FOR I=1 TO 12
  138. 24300 WD(1,I)=CVI(W1$(I))
  139. 24350 WD(2,I)=CVI(W2$(I))
  140. 24400 EL$=EL$ + EG$(WD(2,I))
  141. 24450 NEXT I
  142. 24455 X=INSTR(EL$,"GG")
  143. 24456 IF X=0 THEN 24460
  144. 24457 MID$(EL$,X,2)="NG"
  145. 24460 IF WD(1,1)<> 2 AND WD(1,1)<>10 AND WD(1,1)<>11 AND WD(1,1)<>12 AND WD(1,2)<> 2 AND WD(1,2)<>10 AND WD(1,2)<> 11 AND WD(1,2)<> 12 THEN 24470
  146. 24461 Z=WD(2,1)
  147. 24462 IF Z=1 OR Z=2 OR Z=6 OR Z=8 OR Z=9 OR Z=11 OR Z=17 OR Z=23 OR Z=27 OR Z=28 THEN EL$="H" + EL$:GOTO 24470
  148. 24464 EL$=MID$(EL$,1,1) + "H" + MID$(EL$,2,11)
  149. 24470 GZ=CVI(KG$)
  150. 24500 IF WD(2,1)=99 THEN TR=TR+1:GOTO 24150
  151. 24550 RETURN
  152. 31800 REM ************  PRINT ENTIRE VOCABULARY
  153. 31808 SH$="Y"
  154. 31810 PRINT "DO YOU WISH TO PRINT ACTUAL GREEK? ";
  155. 31815 INPUT SH$
  156. 31817 IF SH$<>"Y" AND SH$<>"N" THEN 31810
  157. 31850 PRINT "DO YOU WISH TO PRINT OUT THE ENTIRE VOCABULARY? (Y OR N)";
  158. 31900 INPUT AX$
  159. 31950 IF AX$<>"Y" AND AX$<>"N" THEN 31850
  160. 32000 BV=1: LV=LR:IP=0
  161. 32050 IF AX$="Y" THEN 32550
  162. 32100 PRINT "DO YOU WISH TO PRINT OUT PART OF THE VOCABULARY? (Y OR N)";
  163. 32150 INPUT AX$
  164. 32200 IF AX$<>"Y" AND AX$<>"N" THEN 32100
  165. 32250 IF AX$="N" THEN 5150
  166. 32300 INPUT "ENTER FIRST WORD NUMBER TO LIST ";BV
  167. 32350 INPUT "ENTER LAST WORD NUMBER TO LIST ";LV
  168. 32400 IF BV<1 THEN BV=1
  169. 32450 IF LV>LR THEN LV=LR
  170. 32500 GOTO 32750
  171. 32550 PRINT "DO YOU WANT A SORTED LISTING? ";
  172. 32600 INPUT AX$
  173. 32650 IF AX$<>"Y" AND AX$<>"N" THEN 32550
  174. 32700 IF AX$="Y" THEN 33000
  175. 32750 FOR TR=BV TO LV
  176. 32800 GOSUB 24100
  177. 32850 GOSUB 34800
  178. 32900 NEXT TR
  179. 32905 LPRINT STRING$(70,"*")
  180. 32910 LPRINT CHR$(12);CHR$(12)
  181. 32950 GOTO 5150
  182. 33000 REM ************ SORT ROUTINE **********************
  183. 33050 GOSUB 4700:PRINT "STANDBY FOR SORT (THIS WILL TAKE A WHILE)" 
  184. 33100 DIM SO$(LR), SO(LR)
  185. 33150 FOR TR=1 TO LR
  186. 33200 GOSUB 24100:PRINT "RECORD ";TR:GOSUB 4850
  187. 33250 FOR I=1 TO 11
  188. 33300 IF WD(2,I)=29 AND WD(2,I+1)=29 THEN WL=I-1:GOTO 33400
  189. 33350 NEXT I
  190. 33400 CD$="":FOR I=1 TO WL STEP 1 
  191. 33450 Z=WD(2,I)
  192. 33550 ZX=Z+65
  193. 33600 IF Z=29 THEN ZX=64
  194. 33650 CD$=CD$+CHR$(ZX)
  195. 33700 NEXT I
  196. 33750 SO$(TR)=CD$:SO(TR)=TR 
  197. 33800 NEXT TR
  198. 33850 PRINT 
  199. 33900 PRINT "FIRST PASS COMPLETE, BEGINNING SECOND PASS":PRINT
  200. 33950 FOR I=1 TO LR-1
  201. 34000 FOR J=1 TO LR-1
  202. 34050 IF SO$(J)<SO$(J+1) THEN 34250
  203. 34100 TP$=SO$(J):TP=SO(J)
  204. 34150 SO$(J)=SO$(J+1):SO(J)=SO(J+1)
  205. 34200 SO$(J+1)=TP$:SO(J+1)=TP
  206. 34250 NEXT J
  207. 34270 GOSUB 4850:PRINT "WORD # ";I
  208. 34300 NEXT I
  209. 34350 PRINT "SORT COMPLETE....BEGINNING PRINTOUT"
  210. 34400 FOR SI=1 TO LR
  211. 34450 TR=SO(SI)
  212. 34500 IF TR<1 OR TR>LR THEN 34600
  213. 34550 GOSUB 24100:GOSUB 34800
  214. 34600 NEXT SI
  215. 34610 LPRINT STRING$(70,"*")
  216. 34650 LPRINT CHR$(12);CHR$(12)
  217. 34700 ERASE SO$, SO
  218. 34750 GOTO 5150
  219. 34800 REM ************ PRINT A WORD ROUTINE
  220. 34850 IP=IP+1
  221. 34860 IF SH$="N" AND IP<>9 THEN 35050
  222. 34870 IF SH$="N" AND IP=9 THEN 34950
  223. 34900 IF IP<>4 THEN 35050
  224. 34950 IP=1:LPRINT STRING$(70,"*")
  225. 35000 LPRINT CHR$(12)
  226. 35050 LPRINT STRING$(70,"*")
  227. 35100 LPRINT "WORD NUMBER ";TR;" WORD TYPE IS ";GZ$(GZ);" DEFINITION IS "
  228. 35150 LPRINT DF$
  229. 35155 LPRINT
  230. 35157 IF SH$="N" THEN 35420
  231. 35160 FOR I = 1 TO 11
  232. 35170 IF WD(2,I)=29 AND WD(2,I+1)=29 THEN WL=I-1:GOTO 35190
  233. 35180 NEXT I
  234. 35182 IF WD(2,12)=29 THEN WL=11
  235. 35184 IF WD(2,12)<>29 THEN WL=12
  236. 35190 Z=WD(2,1)
  237. 35200 TX=INT((12-WL)/2)*6
  238. 35210 SX$=""
  239. 35220 IF WL<12 THEN SX$=" "
  240. 35230 FOR J=1 TO 3
  241. 35240 LPRINT TAB(TX);
  242. 35250 FOR I=1 TO WL
  243. 35260 Z=WD(1,I)
  244. 35270 LPRINT ACC$(Z,J);
  245. 35280 LPRINT SX$;
  246. 35290 NEXT I
  247. 35300 NEXT J
  248. 35310 LPRINT
  249. 35320 FOR J=1 TO 9
  250. 35330 LPRINT TAB(TX);
  251. 35340 FOR I=1 TO WL
  252. 35350 Z=WD(2,I)
  253. 35360 LPRINT LETT$(Z,J);
  254. 35370 LPRINT SX$;
  255. 35380 NEXT I
  256. 35390 LPRINT
  257. 35400 NEXT J
  258. 35410 LPRINT
  259. 35420 X=LEN(EL$)
  260. 35430 Y=40-X/2
  261. 35435 IF SH$="N" THEN Y=1
  262. 35440 LPRINT TAB(Y);EL$
  263. 35450 LPRINT
  264. 35460 RETURN
  265. 43400 DATA "ALPHA","ALPHA-IOTA DIPTHONG","BETA","GAMMA","DELTA","EPSILON","ZETA"
  266. 43450 DATA "ETA","ETA-IOTA DIPTHONG","THETA","IOTA","KAPPA","LAMBDA","MU","NU"
  267. 43500 DATA "XI","OMICRON","PI","RHO","SIGMA","FINAL SIGMA","TAU","UPSILON"
  268. 43550 DATA "PHI","CHI","PSI","OMEGA","OMEGA-IOTA DIPTHONG","BLANK","HYPHEN"
  269. 43600 DATA "SMOOTH BREATH","ROUGH BREATH","ACUTE","CIRCUMFLEX","GRAVE"
  270. 43650 DATA "DIAERSIS","SMOOTH + GRAVE","SMOOTH + ACUTE", "SMOOTH + CIRC."
  271. 43700 DATA "ROUGH + GRAVE", "ROUGH + ACUTE", "ROUGH + CIRC.","CORONIS"
  272. 43750 DATA "APOSTROPHE","BLANK (NO MARK)"
  273. 43800 DATA "A","AI","B","G","D","E","Z","E","EI","TH","I","K","L","M","N"
  274. 43850 DATA "X","O","P","R","S","S","T","U","PH","CH","PS","O","OI"," ","-"
  275. 43860 DATA "VERB","NOUN","PRONOUN","ADJECTIVE","ADVERB","OTHER"
  276. ,"O","P","R","S","